perm filename EUR[AM,DBL]1 blob sn#568257 filedate 1981-02-26 generic text, type T, neo UTF8
(FILECREATED "26-Feb-81 17:08:58" <CSD.LENAT>EUR..8 46326  

     changes to:  EURCOMS Agenda Conjectures Verbosity NU Specialize1LispFn SpecializeNumber (ProtoConjec IsA) (H1 ThenConjecture)

     previous date: "25-Feb-81 19:01:12" <CSD.LENAT>EUR..7)


(PRETTYCOMPRINT EURCOMS)

(RPAQQ EURCOMS [(VARS * EURVARS)
	(FNS * EURFNS)
	(PROP ALL * Units)
	[P (ADVISE (QUOTE EDITP)
		   (QUOTE BEFORE)
		   (QUOTE (OR (STKPOS (QUOTE EU))
			      (PRIN1 "
WARNING:  ARE YOU SURE YOU REALLY DON'T MEAN 'EU' ??? !!! "]
	(GLOBALVARS Agenda CRLF CreditTo Creditors Conjectures CurPri CurReasons CurSlot CurSup CurUnit EditpTemp GCredit Interp 
		    LastEdited NewU NewUnit NewUnits NewValue OldValue RArrow SYSPROPS SlotToChange SlotsToChange Slots TaskNum 
		    UDiff Units UnusedSlots UsedSlots Verbosity WarnSlots conjec cprintmp)
	(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA EU)
									      (NLAML)
									      (LAMA CPRIN1])

(RPAQQ EURVARS (Agenda CRLF Conjectures Interp NewU RArrow Slots Units UnusedSlots UsedSlots Verbosity (FONTCHANGEFLG)
		       (CHANGESARRAY)))

(RPAQQ Agenda NIL)

(RPAQQ CRLF "
")

(RPAQQ Conjectures NIL)

(RPAQQ Interp Interp2)

(RPAQQ NewU NIL)

(RPAQQ RArrow ->)

(RPAQQ Slots (Abbrev Applics Creditors DataType DontCopy DoubleCheck English Examples Format Generalizations IfAboutToWorkOnTask 
		     IfFinishedWorkingOnTask IfParts IfPotentiallyRelevant IfTaskParts IfTrulyRelevant IfWorkingOnTask Inverse 
		     IsA Specializations SubSlots SuperSlots ThenAddToAgenda ThenCompute ThenConjecture ThenDefineNewConcepts 
		     ThenModifySlots ThenParts ThenPrintToUser ToDelete1 Worth))

(RPAQQ Units (ProtoConjec Conjecture IfAboutToWorkOnTask win1 Heuristic Applics IfFinishedWorkingOnTask IsA IfTrulyRelevant 
			  SubSlots IfParts IfPotentiallyRelevant Examples DataType English Worth Inverse H1 H3 H6 H5 H4 Creditors 
			  Generalizations Specializations ThenAddToAgenda ThenCompute ThenConjecture Task Abbrev 
			  ThenDefineNewConcepts ThenModifySlots ThenPrintToUser ThenParts SuperSlots IfTaskParts Format los3 los4 
			  los7 los5 los2 los1 los6))

(RPAQQ UnusedSlots (Creditors Generalizations IfParts IfTaskParts Specializations ThenModifySlots ThenParts))

(RPAQQ UsedSlots (Abbrev Applics DataType DontCopy DoubleCheck English Examples Format IfAboutToWorkOnTask 
			 IfFinishedWorkingOnTask IfPotentiallyRelevant IfTrulyRelevant IfWorkingOnTask Inverse IsA SubSlots 
			 SuperSlots ThenAddToAgenda ThenCompute ThenConjecture ThenDefineNewConcepts ThenPrintToUser ToDelete1 
			 Worth))

(RPAQQ Verbosity 11)

(RPAQ FONTCHANGEFLG NIL)

(RPAQ CHANGESARRAY NIL)

(RPAQQ EURFNS (AddInv AddPropL Average AverageWorths CPRIN1 Certainty Check2AfterEditp CheckAfterEditp Comp CreateUnit CurSup 
		      CycleThruAgenda DecrementCreditAssignment DefineSlot DoubleCheck EU Eurisko ExtractPriority ExtractReasons 
		      ExtractSlotName ExtractUnitName Flatten FractionOf Generalizations Generalize1LispFn Generalize1LispPred 
		      GeneralizeLispFn GeneralizeLispPred HasHighWorth InitializeCreditAssignment Instances Interp1 Interp2 
		      IsAKindOf KillUnit MapUnion NU NearnessTo NewNam REM1PROP RandomChoose RandomP RandomSubst SQUARE START 
		      SelfIntersect SetDiff SlotNames Specializations Specialize1LispFn Specialize1LispPred SpecializeDataType 
		      SpecializeIOPair SpecializeLispFn SpecializeLispPred SpecializeList SpecializeNIL SpecializeNumber 
		      SpecializeSlot SpecializeText SpecializeUnit TrueIfItExists UnionProp Unitp WaxOn WorkOnTask WorkOnUnit 
		      XeqIfItExists YesNo))
(DEFINEQ

(AddInv
  [LAMBDA (un)

          (* edited: "23-FEB-81 18:24")


    (MAP2C (GETPROPLIST un)
	   (CDR (GETPROPLIST un))
	   [FUNCTION (LAMBDA (pr val inv)
	       (AND (SETQ inv (CAR (Inverse pr)))
		    (MAPC val (FUNCTION (LAMBDA (e)
			      (UnionProp e inv un]
	   (QUOTE CDDR])

(AddPropL
  [LAMBDA (L P V)

          (* edited: "24-Feb-81 22:10")



          (* Like ADDPROP, but works for LISTS)


    (COND
      ((ASSOC P L)
	(NCONC1 (ASSOC P L)
		V)
	L)
      (L (NCONC1 L (LIST P V)))
      (T (LIST (LIST P V])

(Average
  [LAMBDA (N M)

          (* edited: "23-FEB-81 14:07")


    (QUOTIENT (PLUS N M 1)
	      2])

(AverageWorths
  [LAMBDA (u v)

          (* edited: "15-FEB-81 17:00")


    (QUOTIENT (PLUS (GETPROP u (QUOTE Worth))
		    (GETPROP v (QUOTE Worth)))
	      2])

(CPRIN1
  [LAMBDA CprinX

          (* edited: "24-FEB-81 18:49")


    [COND
      ((IGREATERP Verbosity (ARG CprinX 1))
	(SETQ cprintmp 1)
	(RPTQ (SUB1 CprinX)
	      (PRIN1 (ARG CprinX (SETQ cprintmp (ADD1 cprintmp]
    T])

(Certainty
  [LAMBDA (N)

          (* edited: "15-FEB-81 17:23")


    (COND
      ((ILESSP N 100)
	(QUOTE Inconceivable))
      ((ILESSP N 400)
	(QUOTE Unlikely))
      ((ILESSP N 600)
	(QUOTE Possible))
      ((ILESSP N 800)
	(QUOTE Probable))
      (T (QUOTE AlmostCertain])

(Check2AfterEditp
  [LAMBDA (oldprop oldval invprop)

          (* edited: "23-FEB-81 18:55")


    (AND (Inverse oldprop)
	 (NULL (GETPROP (CAR EDITPX)
			oldprop))
	 (SETQ invprop (CAR (Inverse oldprop)))
	 (MAPC oldval (FUNCTION (LAMBDA (e)
		   (REM1PROP e invprop (CAR EDITPX])

(CheckAfterEditp
  [LAMBDA (prop val old invprop)

          (* edited: "23-FEB-81 18:53")


    (AND (SETQ invprop (CAR (Inverse prop)))
	 (PROGN [MAPC (SetDiff val (SETQ old (LISTGET EditpTemp prop)))
		      (FUNCTION (LAMBDA (e)
			  (UnionProp e invprop (CAR EDITPX]
		(MAPC (SetDiff old val)
		      (FUNCTION (LAMBDA (e)
			  (REM1PROP e invprop (CAR EDITPX])

(Comp
  [LAMBDA (F D SaveExpr?)

          (* edited: "19-FEB-81 16:20")


    (RESETVARS (LAPFLG STRF SVFLG LCFIL LSTFIL)
	       (SETQ STRF T)
	       (SETQ SVFLG SaveExpr?)
	       (COMPILE1 F D))
    (COND
      (SaveExpr? F)
      (T (REMPROP F (QUOTE EXPR])

(CreateUnit
  [LAMBDA (N NOLD)

          (* edited: "24-FEB-81 17:56")


    (COND
      ((NOT (ATOM N))
	(WARNING (CONS "Must be atomic unit name! You typed: " N)))
      ((MEMB N Units)
	(CreateUnit (NewNam N)
		    NOLD))
      ((MEMB NOLD Units)
	(SETQ Units (CONS N Units))
	(SETQ NewU (CONS N NewU))
	(SETPROPLIST N (SUBST N NOLD (GETPROPLIST NOLD)))
	[MAPC (PROPNAMES N)
	      (FUNCTION (LAMBDA (P)
		  (COND
		    ((GETPROP P (QUOTE DontCopy))
		      (REMPROP N P))
		    ((GETPROP P (QUOTE DoubleCheck))
		      (DoubleCheck N P (GETPROP N P]
	(AddInv N)
	N)
      (T (SETQ Units (CONS N Units))
	 (PUT N (QUOTE Worth)
	      500)
	 N])

(CurSup
  [LAMBDA (ESA)

          (* edited: "23-FEB-81 13:36")


    (CAR (CDDDDR ESA])

(CycleThruAgenda
  [LAMBDA NIL

          (* edited: "15-FEB-81 16:25")


    (PROG (task)
      TLOOP
          (COND
	    (Agenda (SETQ task (CAR Agenda))
		    (SETQ Agenda (CDR Agenda))
		    (WorkOnTask task)

          (* Note that this might add/change the Agenda)


		    T)
	    (T (RETURN NIL)))
          (GO TLOOP])

(DecrementCreditAssignment
  [LAMBDA NIL

          (* edited: "23-FEB-81 16:49")


    (SETQ GCredit (ADD1 GCredit])

(DefineSlot
  [LAMBDA (s)

          (* edited: "19-FEB-81 16:12")



          (* Really this should doublecheck that s isa slot)


    (COND
      ((CCODEP s)

          (* s already has a definition)


	s)
      ((EXPRP s)
	(Comp s (GETD s)
	      T))
      (T [PUTD s (LIST (QUOTE LAMBDA)
		       (LIST (QUOTE u))
		       (LIST (QUOTE GETPROP)
			     (QUOTE u)
			     (KWOTE s]
	 (Comp s (GETD s])

(DoubleCheck
  [LAMBDA (U S V)

          (* edited: "24-FEB-81 17:50")



          (* Check that V contains only valid entries for the S slot of unit U)


    T])

(EU
  [NLAMBDA EDITPX

          (* edited: "24-Feb-81 21:58")


    (COND
      (EDITPX (SETQ LastEdited EDITPX))
      (T (SETQ EDITPX LastEdited)
	 (PRIN1 "=")
	 (PRIN1 (CAR EDITPX))
	 (TERPRI)))
    [SETQ EditpTemp (COPY (GETPROPLIST (CAR EDITPX]
    (EVAL (CONS (QUOTE EDITP)
		EDITPX))
    (MAP2C (GETPROPLIST (CAR EDITPX))
	   (CDR (GETPROPLIST (CAR EDITPX)))
	   (FUNCTION CheckAfterEditp)
	   (QUOTE CDDR))
    (MAP2C EditpTemp (CDR EditpTemp)
	   (FUNCTION Check2AfterEditp)
	   (QUOTE CDDR))
    (CONS (QUOTE FinishedEditing)
	  EDITPX])

(Eurisko
  [LAMBDA (Verbo)

          (* edited: "24-FEB-81 18:20")


    (COND
      ((FIXP Verbo)
	(SETQ Verbosity Verbo))
      (T NIL))
    (COND
      [[PROGN (PRIN1 "


				Starting EURISKO



Initialize entire state? ")
	      (MEMB (RATOM)
		    (QUOTE (Y YES y yes Yes]
	(SETQ Agenda NIL)
	(SETQ Conjectures NIL)
	(AND NewU (CPRIN1 0 CRLF "Eliminate the recently synthesized units? ")
	     (CPRIN1 20 NewU)
	     (YesNo)
	     (MAPC (COPY NewU)
		   (QUOTE KillUnit)))
	(SETQ UnusedSlots NIL)
	(SETQ UsedSlots NIL)
	[MAPC Units (FUNCTION (LAMBDA (U)
		  (MAPC (PROPNAMES U)
			(FUNCTION (LAMBDA (SL)
			    (OR (MEMB SL UsedSlots)
				(MEMB SL SYSPROPS)
				(PROGN (SETQ UsedSlots (CONS SL UsedSlots))
				       (DefineSlot SL]
	[MAPC Units (FUNCTION (LAMBDA (u)
		  (AND (MEMB (QUOTE Slot)
			     (GETPROP u (QUOTE IsA)))
		       (NOT (MEMB u UsedSlots))
		       (SETQ UnusedSlots (CONS u UnusedSlots))
		       (DefineSlot u]
	(SETQ UsedSlots (SORT UsedSlots))
	(SETQ UnusedSlots (SORT UnusedSlots))
	(SETQ Slots (MERGE (APPEND UsedSlots)
			   (APPEND UnusedSlots]
      (T NIL))
    (SETQ TaskNum 0)
    (CPRIN1 -1 CRLF "Ready to start? ")
    (COND
      ((YesNo)
	(START))
      (T "Type (START) when you are ready."])

(ExtractPriority
  [LAMBDA (ESA)

          (* edited: "23-FEB-81 14:01")


    (CAR ESA])

(ExtractReasons
  [LAMBDA (ESA)

          (* edited: "23-FEB-81 13:35")


    (CADDDR ESA])

(ExtractSlotName
  [LAMBDA (ESA)

          (* edited: "23-FEB-81 13:35")


    (CADDR ESA])

(ExtractUnitName
  [LAMBDA (task)

          (* edited: "15-FEB-81 16:39")


    (CADR task])

(Flatten
  [LAMBDA (L)

          (* edited: "23-FEB-81 17:25")


    (COND
      ((NULL L)
	NIL)
      ((ATOM L)
	(LIST L))
      (T (MAPCONC L (QUOTE Flatten])

(FractionOf
  [LAMBDA (L P)

          (* edited: "24-FEB-81 18:39")



          (* compute the fraction of entries on L which satisfy predicate P)


    (COND
      ((ATOM L)
	0)
      (T (QUOTIENT (FLOAT (LENGTH (SUBSET L P)))
		   (FLOAT (LENGTH L])

(Generalizations
  [LAMBDA (u)

          (* edited: "19-FEB-81 16:36")


    (SelfIntersect (NCONC [MAPCONC (GETPROP (QUOTE Generalizations)
					    (QUOTE SubSlots))
				   (FUNCTION (LAMBDA (ss)
				       (APPEND (GETPROP u ss]
			  (GETPROP u (QUOTE Generalizations])

(Generalize1LispFn
  [LAMBDA (bod tmp)

          (* edited: "23-FEB-81 17:34")


    (RandomSubst [RandomChoose (Generalizations (SETQ tmp (RandomChoose (SUBSET (SUBSET (SelfIntersect (Flatten bod))
											(QUOTE Unitp))
										(QUOTE Generalizations]
		 tmp bod])

(Generalize1LispPred
  [LAMBDA (bod tmp)

          (* edited: "23-FEB-81 17:34")


    (RandomSubst [RandomChoose (Generalizations (SETQ tmp (RandomChoose (SUBSET (SUBSET (SelfIntersect (Flatten bod))
											(QUOTE Unitp))
										(QUOTE Generalizations]
		 tmp bod])

(GeneralizeLispFn
  [LAMBDA (x)

          (* edited: "23-FEB-81 17:32")



          (* presumed to be given either the name of a predicate, or a list of the form (LAMBDA --))


    (COND
      ((ATOM x)
	(OR (RandomChoose (Generalizations x))
	    x))
      [(LISTP (CAR x))
	(MAPCAR x (FUNCTION (LAMBDA (Z)
		    (COND
		      ((RandomP)
			(GeneralizeLispFn Z))
		      (T Z]
      [(EQ (CAR x)
	   (QUOTE LAMBDA))
	(CONS (QUOTE LAMBDA)
	      (CONS (CADR x)
		    (MAPCAR (CDDR x)
			    (QUOTE Generalize1LispFn]
      (T x])

(GeneralizeLispPred
  [LAMBDA (x)

          (* edited: "23-FEB-81 17:32")



          (* presumed to be given either the name of a predicate, or a list of the form (LAMBDA --))


    (COND
      ((ATOM x)
	(OR (RandomChoose (Generalizations x))
	    x))
      [(LISTP (CAR x))
	(MAPCAR x (FUNCTION (LAMBDA (Z)
		    (COND
		      ((RandomP)
			(GeneralizeLispPred Z))
		      (T Z]
      [(EQ (CAR x)
	   (QUOTE LAMBDA))
	(CONS (QUOTE LAMBDA)
	      (CONS (CADR x)
		    (MAPCAR (CDDR x)
			    (QUOTE Generalize1LispPred]
      (T x])

(HasHighWorth
  [LAMBDA (u)

          (* edited: "15-FEB-81 13:48")


    (AND (Unitp u)
	 (GREATERP (GETPROP u (QUOTE Worth))
		   800])

(InitializeCreditAssignment
  [LAMBDA NIL

          (* edited: "23-FEB-81 16:49")


    (SETQ GCredit 1])

(Instances
  [LAMBDA (u)

          (* edited: "23-FEB-81 13:53")


    (SELECTQ (CAR (IsA u))
	     (Heuristic (QUOTE Applics))
	     (QUOTE Examples])

(Interp1
  [LAMBDA (r ArgU)

          (* edited: "15-FEB-81 14:13")



          (* assembles pieces of the heuristic rule r, and runs them on argument ArgU)


    (COND
      ((EVERY (GETPROP (QUOTE IfParts)
		       (QUOTE SubSlots))
	      (QUOTE TrueIfItExists)))
      (T NIL])

(Interp2
  [LAMBDA (r ArgU)

          (* edited: "24-Feb-81 21:30")



          (* assembles pieces of the heuristic rule r, and runs them on argument ArgU)



          (* This is a more "vocal" interpeter than interp1)


    (COND
      ((EVERY (GETPROP (QUOTE IfParts)
		       (QUOTE SubSlots))
	      (QUOTE TrueIfItExists))
	(COND
	  ((IGREATERP Verbosity 66)
	    (PRIN1 "	All the IfParts of ")
	    (PRIN1 r)
	    (PRIN1 (GETPROP r (QUOTE Abbrev)))
	    (PRIN1 " are satisfied, so we are applying the ThenParts. ")
	    (TERPRI))
	  ((IGREATERP Verbosity 50)
	    (PRIN1 r)
	    (PRIN1 " applies. ")
	    (TERPRI)))
	(AND (EVERY (GETPROP (QUOTE ThenParts)
			     (QUOTE SubSlots))
		    (QUOTE XeqIfItExists))
	     (CPRIN1 68 CRLF "	All the ThenParts of " r (GETPROP r (QUOTE Abbrev))
		     " have been successfully executed. " CRLF)))
      (T NIL])

(IsAKindOf
  [LAMBDA (s S)

          (* edited: "23-FEB-81 13:45")


    (OR (EQ s S)
	(MEMB S (Generalizations s])

(KillUnit
  [LAMBDA (u)

          (* edited: "25-FEB-81 16:33")


    (SETQ Units (DREMOVE u Units))
    (SETQ NewU (DREMOVE u NewU))
    [MAP2C (GETPROPLIST u)
	   (CDR (GETPROPLIST u))
	   (FUNCTION (LAMBDA (P V temp)
	       (COND
		 [[SETQ temp (CAR (GETPROP P (QUOTE Inverse]
		   (MAPC V (FUNCTION (LAMBDA (e)
			     (REM1PROP e temp u]
		 ((SETQ temp (GETPROP P (QUOTE ToDelete)))
		   (APPLY* temp V P u))
		 ((SETQ temp (GETPROP P (QUOTE ToDelete1)))
		   (MAPC V (FUNCTION (LAMBDA (e)
			     (APPLY* temp e P u]
    (SETPROPLIST u NIL])

(MapUnion
  [LAMBDA (L F)

          (* edited: "15-FEB-81 13:42")



          (* like MAPCONC, but instead of NCONCing the results we simply, nondestructive, union them)


    (COND
      ((ATOM L)
	NIL)
      (T (UNION (APPLY* F (CAR L))
		(MapUnion (CDR L)
			  F])

(NU
  [LAMBDA (N NOLD)

          (* edited: "26-Feb-81 15:39")


    (COND
      ((NOT (ATOM N))
	(PRIN1 "Must be atomic unit name! You typed: ")
	N)
      ((MEMB N Units)
	(PRIN1 "Sorry, it is already a unit! " N))
      ((MEMB NOLD Units)
	(SETQ Units (CONS N Units))
	(SETPROPLIST N (SUBST N NOLD (GETPROPLIST NOLD)))
	(SETQ WarnSlots NIL)
	[MAPC (PROPNAMES N)
	      (FUNCTION (LAMBDA (P)
		  (COND
		    ((GETPROP P (QUOTE DontCopy))
		      (REMPROP N P))
		    ((GETPROP P (QUOTE DoubleCheck))
		      (SETQ WarnSlots (CONS P WarnSlots]
	(COND
	  (WarnSlots (CPRIN1 0 CRLF "Warning: doublecheck the values stored in: " WarnSlots CRLF CRLF)))
	(EVAL (LIST (QUOTE EU)
		    N))
	(AddInv N)
	(LIST N (QUOTE HasBeenInitialized)))
      (T (SETQ Units (CONS N Units))
	 (PUT N (QUOTE Worth)
	      500)
	 (EVAL (LIST (QUOTE EU)
		     N))
	 (AddInv N)
	 (LIST N (QUOTE HasBeenInitialized])

(NearnessTo
  [LAMBDA (N X)

          (* edited: "24-Feb-81 22:21")



          (* This certainly works for nearness of N to .1)


    (DIFFERENCE 1000 (TIMES 100000 (SQUARE (DIFFERENCE N X])

(NewNam
  [LAMBDA (A)

          (* edited: "25-FEB-81 18:52")


    (PROG (N M)
          (SETQ N 1)
      NLOOP
          (SETQ M (PACK* A (QUOTE -)
			 N))
          (COND
	    ((Unitp M)
	      (SETQ N (ADD1 N))
	      (GO NLOOP))
	    (T (RETURN M])

(REM1PROP
  [LAMBDA (a p v)

          (* edited: "23-FEB-81 18:39")


    (COND
      ((DREMOVE v (GETPROP a p)))
      (T (REMPROP a p])

(RandomChoose
  [LAMBDA (L)

          (* edited: "23-FEB-81 14:14")


    (CAR (NTH L (RAND 1 (LENGTH L])

(RandomP
  [LAMBDA NIL

          (* edited: "23-FEB-81 14:25")


    (EQ 1 (RAND 0 1])

(RandomSubst
  [LAMBDA (X Y Z)

          (* edited: "25-FEB-81 18:46")


    (COND
      ((EQUAL X Y)
	Z)
      ((EQUAL Y Z)
	(COND
	  ((RandomP)
	    Y)
	  (T X)))
      ((NLISTP Z)
	Z)
      (T (CONS (RandomSubst X Y (CAR Z))
	       (RandomSubst X Y (CDR Z])

(SQUARE
  [LAMBDA (X)

          (* edited: "24-Feb-81 22:19")


    (TIMES X X])

(START
  [LAMBDA NIL

          (* edited: "24-FEB-81 18:20")


    (PROG NIL
      LOOP(MAPC [PROGN (COND
			 ((IGREATERP Verbosity 35)
			   (PRIN1 "
Sorting the units by worth.
"))
			 ((IGREATERP Verbosity 15)
			   (PRIN1 "	Arranging the tasks in order.  
")))
		       (SETQ Units (SORT Units (FUNCTION (LAMBDA (u v)
					     (IGREATERP (GETPROP u (QUOTE Worth))
							(GETPROP v (QUOTE Worth]
		(QUOTE WorkOnUnit))
          (PRIN1 "
Should I continue with another pass? ")
          (COND
	    ((MEMB (RATOM)
		   (QUOTE (Y y Yes YES yes)))
	      (GO LOOP)))
          (RETURN (QUOTE EuriskoHalting])

(SelfIntersect
  [LAMBDA (X)

          (* edited: "19-FEB-81 16:36")


    (INTERSECTION X X])

(SetDiff
  [LAMBDA (L M)

          (* edited: "23-FEB-81 19:03")



          (* presumes that L and M are lists of atoms. Nondestructive)


    (SUBSET L (FUNCTION (LAMBDA (v)
		(NOT (MEMB v M])

(SlotNames
  [LAMBDA (u)

          (* edited: "23-FEB-81 14:16")


    (SUBSET (PROPNAMES u)
	    (FUNCTION (LAMBDA (S)
		(NOT (MEMB S SYSPROPS])

(Specializations
  [LAMBDA (u)

          (* edited: "19-FEB-81 16:36")


    (SelfIntersect (NCONC [MAPCONC (GETPROP (QUOTE Specializations)
					    (QUOTE SubSlots))
				   (FUNCTION (LAMBDA (ss)
				       (APPEND (GETPROP u ss]
			  (GETPROP u (QUOTE Specializations])

(Specialize1LispFn
  [LAMBDA (bod tmp tmp2)

          (* edited: "26-Feb-81 15:30")


    (COND
      ([SETQ tmp2 (RandomChoose (Specializations (SETQ tmp (RandomChoose (SUBSET (SUBSET (SelfIntersect (Flatten bod))
											 (QUOTE Unitp))
										 (QUOTE Specializations]
	(SETQ UDiff (LIST tmp RArrow tmp2))
	(RandomSubst tmp2 tmp bod))
      ([SETQ tmp2 (SpecializeNumber (SETQ tmp (RandomChoose (SUBSET (SelfIntersect (Flatten bod))
								    (QUOTE NUMBERP]
	(SETQ UDiff (LIST tmp RArrow tmp2))
	(RandomSubst tmp2 tmp bod))
      (T NIL])

(Specialize1LispPred
  [LAMBDA (bod tmp tmp2)

          (* edited: "25-FEB-81 17:01")


    (COND
      ([SETQ tmp2 (RandomChoose (Specializations (SETQ tmp (RandomChoose (SUBSET (SUBSET (SelfIntersect (Flatten bod))
											 (QUOTE Unitp))
										 (QUOTE Specializations]
	(SETQ UDiff (LIST tmp RArrow tmp2))
	(RandomSubst tmp2 tmp bod])

(SpecializeDataType
  [LAMBDA (x tmp)

          (* edited: "25-FEB-81 17:06")


    (COND
      [(LISTP x)
	(MAPCAR x (FUNCTION (LAMBDA (Z)
		    (COND
		      ((RandomP)
			(SpecializeDataType Z))
		      (T Z]
      ((SETQ tmp (RandomChoose (Specializations x)))
	(SETQ UDiff (List x RArrow tmp))
	tmp)
      (T x])

(SpecializeIOPair
  [LAMBDA (x)

          (* edited: "23-FEB-81 15:33")


    (COND
      ((LISTP x)
	(SUBSET x (QUOTE RandomP)))
      (T (MAPCAR x (QUOTE SpecializeUnit])

(SpecializeLispFn
  [LAMBDA (x)

          (* edited: "23-FEB-81 17:32")



          (* presumed to be given either the name of a predicate, or a list of the form (LAMBDA --))


    (COND
      ((ATOM x)
	(OR (RandomChoose (Specializations x))
	    x))
      [(LISTP (CAR x))
	(MAPCAR x (FUNCTION (LAMBDA (Z)
		    (COND
		      ((RandomP)
			(SpecializeLispFn Z))
		      (T Z]
      [(EQ (CAR x)
	   (QUOTE LAMBDA))
	(CONS (QUOTE LAMBDA)
	      (CONS (CADR x)
		    (MAPCAR (CDDR x)
			    (QUOTE Specialize1LispFn]
      (T x])

(SpecializeLispPred
  [LAMBDA (x)

          (* edited: "23-FEB-81 17:32")



          (* presumed to be given either the name of a predicate, or a list of the form (LAMBDA --))


    (COND
      ((ATOM x)
	(OR (RandomChoose (Specializations x))
	    x))
      [(LISTP (CAR x))
	(MAPCAR x (FUNCTION (LAMBDA (Z)
		    (COND
		      ((RandomP)
			(SpecializeLispPred Z))
		      (T Z]
      [(EQ (CAR x)
	   (QUOTE LAMBDA))
	(CONS (QUOTE LAMBDA)
	      (CONS (CADR x)
		    (MAPCAR (CDDR x)
			    (QUOTE Specialize1LispPred]
      (T x])

(SpecializeList
  [LAMBDA (x)

          (* edited: "25-FEB-81 17:12")


    (COND
      [(LISTP (CAR x))
	(MAPCAR x (FUNCTION (LAMBDA (Z)
		    (COND
		      ((RandomP)
			(SpecializeList Z))
		      (T Z]
      (T (SETQ UDiff (LIST (QUOTE Eliminated:)))
	 (SUBSET x (FUNCTION (LAMBDA (R)
		     (COND
		       ((RandomP)
			 (NCONC1 UDiff R)
			 NIL)
		       (T T])

(SpecializeNIL
  [LAMBDA (X)

          (* edited: "23-FEB-81 14:51")


    (WARNING (CONS X " can't be specialized if it doesn't have a known DataType! "])

(SpecializeNumber
  [LAMBDA (x)

          (* edited: "26-Feb-81 15:29")


    (COND
      [(LISTP x)
	(MAPCAR x (FUNCTION (LAMBDA (Z)
		    (COND
		      ((RandomP)
			(SpecializeNumber Z))
		      (T Z]
      [(FIXP x)
	(CADDR (SETQ UDiff (LIST x RArrow (RAND 1 x]
      [(NUMBERP x)
	(CADDR (SETQ UDiff (LIST x RArrow (QUOTIENT (RAND 0 (FIX (TIMES x 200)))
						    200.0]
      (T NIL])

(SpecializeSlot
  [LAMBDA (x tmp)

          (* edited: "25-FEB-81 17:27")


    (COND
      [(LISTP x)
	(MAPCAR x (FUNCTION (LAMBDA (Z)
		    (COND
		      ((RandomP)
			(SpecializeSlot Z))
		      (T Z]
      ((SETQ tmp (RandomChoose (Specializations x)))
	(SETQ UDiff (LIST x RArrow tmp))
	tmp)
      (T x])

(SpecializeText
  [LAMBDA (x)

          (* edited: "25-FEB-81 17:26")


    (COND
      [(LISTP (CAR x))
	(MAPCAR x (FUNCTION (LAMBDA (Z)
		    (COND
		      ((RandomP)
			(SpecializeText Z))
		      (T Z]
      (T (SETQ UDiff (LIST (QUOTE Eliminated:)))
	 (SUBSET x (FUNCTION (LAMBDA (R)
		     (COND
		       ((RandomP)
			 (NCONC1 UDiff R)
			 NIL)
		       (T T])

(SpecializeUnit
  [LAMBDA (x tmp)

          (* edited: "25-FEB-81 17:27")


    (COND
      [(LISTP x)
	(MAPCAR x (FUNCTION (LAMBDA (Z)
		    (COND
		      ((RandomP)
			(SpecializeUnit Z))
		      (T Z]
      ((SETQ tmp (RandomChoose (Specializations x)))
	(SETQ UDiff (LIST x RArrow tmp))
	tmp)
      (T x])

(TrueIfItExists
  [LAMBDA (s)

          (* edited: "15-FEB-81 15:40")



          (* This is an aux fn of rule interpreters. We assume that the interpreter is being run on a rule called r, 
	  which is to be applied to a unit ArgU)


    ([LAMBDA (z)
	(COND
	  ((NULL z))
	  ((ILESSP Verbosity 80)
	    (APPLY* z ArgU))
	  ((APPLY* z ArgU)
	    (PRIN1 "		the ")
	    (PRIN1 s)
	    (PRIN1 " slot of ")
	    (PRIN1 r)
	    (PRIN1 " holds for ")
	    (PRIN1 ArgU)
	    (TERPRI)
	    T)
	  ((IGREATERP Verbosity 95)
	    (PRIN1 "		the ")
	    (PRIN1 s)
	    (PRIN1 " slot of ")
	    (PRIN1 r)
	    (PRIN1 " didn't hold for ")
	    (PRIN1 ArgU)
	    (TERPRI)
	    NIL]
      (GETPROP r s])

(UnionProp
  [LAMBDA (A P V flag)

          (* edited: "23-FEB-81 18:21")


    (OR (MEMB V (GETPROP A P))
	(ADDPROP A P V flag])

(Unitp
  [LAMBDA (u)

          (* edited: "15-FEB-81 13:48")



          (* u is a unit iff it has a Worth property on its plist)


    (GETPROP u (QUOTE Worth])

(WaxOn
  [LAMBDA (task)

          (* edited: "15-FEB-81 17:25")


    (LIST (QUOTE It)
	  (QUOTE is)
	  (Certainty (CAR task))
	  (LIST (CAR task))
	  (QUOTE that)
	  (QUOTE finding)
	  (CADDR task)
	  (QUOTE of)
	  (CADR task)
	  (QUOTE will)
	  (QUOTE be)
	  (QUOTE worthwhile,)
	  (QUOTE since:)
	  (CADDDR task])

(WorkOnTask
  [LAMBDA (task ArgU TaskResults)

          (* edited: "25-FEB-81 16:02")


    (SETQ TaskNum (ADD1 TaskNum))
    (COND
      ((IGREATERP Verbosity 50)
	(CPRIN1 1 CRLF "Task " TaskNum ":  Working on a new promising task:  " (WaxOn task)
		CRLF))
      ((IGREATERP Verbosity 10)
	(TERPRI)
	(PRIN1 "Task ")
	(PRIN1 TaskNum)
	(PRIN1 ": ")
	(PRIN1 "Working on the promising task ")
	(PRIN1 task)
	(TERPRI)))
    (SETQ CurPri (ExtractPriority task))
    (SETQ ArgU task)
    (SETQ CurUnit (ExtractUnitName task))
    (SETQ CurSlot (ExtractSlotName task))
    (SETQ CurReasons (ExtractReasons task))
    (SETQ CurSup (CurSup task))
    [MAPC (GETPROP (QUOTE IfTaskParts)
		   (QUOTE SubSlots))
	  (FUNCTION (LAMBDA (p)
	      (MAPC (GETPROP (QUOTE Heuristic)
			     (QUOTE Examples))
		    (FUNCTION (LAMBDA (r)

          (* try to apply r to current task)


			(COND
			  ((NULL (GETPROP r p))
			    T)
			  ((APPLY* (GETPROP r p)
				   task)
			    (CPRIN1 71 "	The " p " slot of heuristic " r (GETPROP r (QUOTE Abbrev))
				    " applies to the current task. " CRLF)
			    (AND (EVERY (GETPROP (QUOTE ThenParts)
						 (QUOTE SubSlots))
					(QUOTE XeqIfItExists))
				 (CPRIN1 75 "	The Then Parts of the rule have been executed. 
" CRLF)))
			  (T NIL]
    (CPRIN1 64 " The results of this task were: " TaskResults CRLF)
    (CPRIN1 65 CRLF)
    TaskResults])

(WorkOnUnit
  [LAMBDA (U TaskResults)

          (* edited: "25-FEB-81 18:01")


    (SETQ TaskNum (ADD1 TaskNum))
    (COND
      ((IGREATERP Verbosity 10)
	(TERPRI)
	(PRIN1 "Task ")
	(PRIN1 TaskNum)
	(PRIN1 ": ")
	(PRIN1 "Focusing on ")
	(PRIN1 U)
	(TERPRI)))
    [MAPC (GETPROP (QUOTE Heuristic)
		   (QUOTE Examples))
	  (FUNCTION (LAMBDA (H)

          (* try to apply H to unit U)


	      (APPLY* Interp H U]
    (CPRIN1 65 CRLF)
    (CPRIN1 64 " The results of this task so far are: " TaskResults CRLF)
    (CPRIN1 65 CRLF)
    (CycleThruAgenda])

(XeqIfItExists
  [LAMBDA (s)

          (* edited: "15-FEB-81 15:40")



          (* This is an aux fn of rule interpreters. We assume that the interpreter is being run on a rule called r, 
	  which is to be applied to a unit ArgU)



          (* This function evaluates the s part of r, which is presumably a Then- part of some sort)


    ([LAMBDA (z)
	(COND
	  ((NULL z)
	    T)
	  ((APPLY* z ArgU)
	    (COND
	      ((IGREATERP Verbosity 80)
		(PRIN1 "		the ")
		(PRIN1 s)
		(PRIN1 " slot of ")
		(PRIN1 r)
		(PRIN1 " has been applied to ")
		(PRIN1 ArgU)
		(TERPRI)
		T))
	    T)
	  ((IGREATERP Verbosity 75)
	    (PRIN1 "		the ")
	    (PRIN1 s)
	    (PRIN1 " slot of ")
	    (PRIN1 r)
	    (PRIN1 " was applied to ")
	    (PRIN1 ArgU)
	    (PRIN1 " but for some reason it signalled a failure")
	    (COND
	      ((IGREATERP Verbosity 90)
		(PRIN1 ", so the remaining ThenParts of the rule weren't applied.")))
	    (TERPRI)
	    NIL]
      (GETPROP r s])

(YesNo
  [LAMBDA (i)

          (* edited: "24-FEB-81 18:01")


    (MEMB (OR i (RATOM))
	  (QUOTE (Y Yes YES y yes])
)

(RPAQQ Units (ProtoConjec Conjecture IfAboutToWorkOnTask win1 Heuristic Applics IfFinishedWorkingOnTask IsA IfTrulyRelevant 
			  SubSlots IfParts IfPotentiallyRelevant Examples DataType English Worth Inverse H1 H3 H6 H5 H4 Creditors 
			  Generalizations Specializations ThenAddToAgenda ThenCompute ThenConjecture Task Abbrev 
			  ThenDefineNewConcepts ThenModifySlots ThenPrintToUser ThenParts SuperSlots IfTaskParts Format los3 los4 
			  los7 los5 los2 los1 los6))
  (PUTPROPS ProtoConjec Worth 800
                        IsA (Conjecture))
  (PUTPROPS Conjecture Worth 500
                       Examples (ProtoConjec))
  (PUTPROPS IfAboutToWorkOnTask Worth 800
                                IsA (Slot)
                                SuperSlots (IfParts)
                                DataType LispPred)
  (PUTPROPS win1 Worth 904)
  (PUTPROPS Heuristic Worth 900
                      Examples (H1 H5 H6 H3 H4))
  (PUTPROPS Applics Worth 800
                    IsA (Slot)
                    Format ((situation resultant-units directness)
			    (situation resultant-units directness)
			    etc.)
                    DataType IOPair
                    SubSlots (DirectApplics IndirectApplics)
                    DoubleCheck T
                    DontCopy T)
  (PUTPROPS IfFinishedWorkingOnTask Worth 800
                                    IsA (Slot)
                                    SuperSlots (IfTaskParts)
                                    DataType LispPred)
  (PUTPROPS IsA Worth 800
                IsA (Slot)
                Inverse (Examples)
                DataType Unit
                DoubleCheck T)
  (PUTPROPS IfTrulyRelevant Worth 800
                            IsA (Slot)
                            SuperSlots (IfParts)
                            DataType LispPred)
  (PUTPROPS SubSlots Worth 800
                     IsA (Slot)
                     Inverse (SuperSlots)
                     SuperSlots (Specializations)
                     DataType Slot
                     DoubleCheck T)
  (PUTPROPS IfParts Worth 800
                    SubSlots (IfPotentiallyRelevant IfTrulyRelevant IfAboutToWorkOnTask)
                    IsA (Slot)
                    DataType LispPred)
  (PUTPROPS IfPotentiallyRelevant Worth 800
                                  IsA (Slot)
                                  SuperSlots (IfParts)
                                  DataType LispPred)
  (PUTPROPS Examples Worth 800
                     IsA (Slot)
                     Inverse (IsA)
                     DataType Unit
                     DoubleCheck T
                     DontCopy T)
  (PUTPROPS DataType Worth 800
                     IsA (Slot)
                     DataType DataType)
  (PUTPROPS English Worth 800
                    IsA (Slot)
                    DataType Text)
  (PUTPROPS Worth Worth 800
                  IsA (Slot)
                  DataType Number)
  (PUTPROPS Inverse Worth 700
                    IsA (Slot)
                    Inverse (Inverse)
                    DataType Slot)
  (PUTPROPS H1 IsA (Heuristic)
               English (IF the results of performing f are only occasionally useful , THEN consider creating new specializations 
			   of f)
               IfPotentiallyRelevant [LAMBDA (f)
					     (* check that f has some recorded applications -- which implies, of course, that f 
						is an executable/performable entity)
					     (GETPROP f (QUOTE Applics]
               IfTrulyRelevant [LAMBDA (f)
				       (* check that some Applics of f have high Worth, but most have low Worth)
				       (* the extent to which those conditions are met will determine the amount of energy to 
					  expend working on applying this rule -- its overall relevancy)
				       (AND [SOME (GETPROP f (QUOTE Applics))
						  (QUOTE (LAMBDA (a)
								 (* this will have the format (args results))
								 (SOME (CADR a)
								       (QUOTE HasHighWorth]
					    (GREATERP .2 (SETQ Fraction (FractionOf (MapUnion (GETPROP f (QUOTE Applics))
											      (QUOTE CADR))
										    (QUOTE HasHighWorth]
               Worth 700
               Applics ((sit1 (win1 los1))
			(sit2 (los2 los3 los4 los5 los6)))
               Abbrev (Specialize a sometimes-useful action)
               ThenPrintToUser [LAMBDA (f)
				       (CPRIN1 13 "
" conjec ":" "
Since some specializations of " f " " (CONS "i.e., " (GETPROP f (QUOTE Abbrev)))
					       

" are quite valuable, but over four-fifths are trash, EURISKO has recognized the value of finding new concepts similar to -- but more specialized than -- "
					       f 
				      ", and (to that end) has added a new task to the agenda to find such specializations. ")
				       T]
               ThenConjecture [LAMBDA (f)
				      (SETQ Conjectures
					    (CONS (PROGN (SETQ conjec (NewNam (QUOTE Conjec)))
							 (CreateUnit conjec (QUOTE ProtoConjec))
							 [PUT conjec (QUOTE English)
							      (NCONC (LIST (QUOTE Specializations)
									   (QUOTE of)
									   f)
								     (QUOTE (may be more useful than it is, since it has some 
										 good instances but many more poor ones))
								     (LIST (LIST (DIFFERENCE 1.0 Fraction]
							 [PUT conjec (QUOTE Abbrev)
							      (CONS f
								    (QUOTE (sometimes wins, usually loses, so specializations of 
										      it may win big]
							 [PUT conjec (QUOTE Worth)
							      (FIX (Average (NearnessTo Fraction .1)
									    (AverageWorths (QUOTE H1)
											   f]
							 conjec)
						  Conjectures]
               ThenAddToAgenda [LAMBDA (f)
				       (SETQ Agenda (MERGE [LIST (LIST (AverageWorths f (QUOTE H1))
								       f
								       (QUOTE Specializations)
								       (LIST conjec)
								       (LIST (LIST (QUOTE CreditTo)
										   (QUOTE H1]
							   Agenda T))
				       (AddPropL TaskResults (QUOTE NewTasks)
						 (QUOTE (1 unit must be specialized])
  (PUTPROPS H3 IsA (Heuristic)
               English (IF the current task is to specialize a unit, and no specific slot has been chosen to be the one changed, 
			   THEN randomly select a slot to specialize)
               IfPotentiallyRelevant NULL
               Worth 700
               Applics ((sit1 (win1 los1)))
               Abbrev (Specialize u by specializing one random slot)
               IfAboutToWorkOnTask [LAMBDA (task)
					   (AND (IsAKindOf CurSlot (QUOTE Specializations))
						(NULL (ASSOC (QUOTE SlotToChange)
							     CurSup]
               ThenPrintToUser [LAMBDA (task)
				       (CPRIN1 13 CRLF NewReason CRLF CRLF)
				       T]
               ThenAddToAgenda [LAMBDA (task)
				       (SETQ Agenda (MERGE [LIST (LIST (Average CurPri (AverageWorths CurUnit (QUOTE H3)))
								       CurUnit CurSlot (CONS (SETQ NewReason
												   (CONCAT 
									    "A new unit will be created by specializing the "
													   SlotToChange 
													   " slot of "
													   CurUnit 
											   "; that slot was chosen randomly."))
											     CurReasons)
								       (LIST (LIST (QUOTE SlotToChange)
										   SlotToChange)
									     (CONS (QUOTE CreditTo)
										   (CONS (QUOTE H3)
											 CreditTo]
							   Agenda T))
				       (SETQ TaskResults (AddPropL TaskResults (QUOTE NewTasks)
								   (LIST 1 (QUOTE specific)
									 (QUOTE slot)
									 (QUOTE of)
									 CurUnit
									 (QUOTE to)
									 (QUOTE find)
									 CurSlot
									 (QUOTE of]
               ThenCompute [LAMBDA (task)
				   (SETQ SlotToChange (RandomChoose (SlotNames CurUnit)))
				   (SETQ CreditTo (CDR (ASSOC (QUOTE CreditTo)
							      CurSup)))
				   T])
  (PUTPROPS H6 IsA (Heuristic)
               English (IF the current task is to specialize a unit, and a slot has been chosen to be the one changed, THEN 
			   randomly select a part of it and specialize that part)
               IfPotentiallyRelevant NULL
               Worth 700
               Abbrev (Specialize a given slot of a given unit)
               IfWorkingOnTask [LAMBDA (task)
				       (AND (IsAKindOf CurSlot (QUOTE Specializations))
					    (SETQ SlotToChange (CADR (ASSOC (QUOTE SlotToChange)
									    CurSup]
               ThenPrintToUser [LAMBDA (task)
				       (CPRIN1 13 CRLF "Specialized the " SlotToChange " slot of " CurUnit 
					       ", replacing its old value ")
				       (CPRIN1 48 "(which was " OldValue ") ")
				       (CPRIN1 14 "by " NewValue "." CRLF)
				       (CPRIN1 13 CRLF)
				       T]
               ThenCompute [LAMBDA (task)
				   (* assumes the existence of functions SpecializeLispPred SpecializeLispFn SpecializeList and 
				      of course SpecializeNIL to catch the slots which have not DataType slot)
				   (SETQ UDiff NIL)
				   [SETQ NewValue (APPLY* (PACK* (QUOTE Specialize)
								 (DataType SlotToChange))
							  (SETQ OldValue (GETPROP CurUnit SlotToChange]
				   (* If the OldValue and NewValue are equal, then we really haven't specialized it at all, so we 
				      want to return NIL and have this rule FAIL)
				   (COND ((EQUAL OldValue NewValue)
					  (CPRIN1 15 CRLF "Hmmm... couldn't seem to find any meaningful specialization of the " 
						  SlotToChange " slot of " CurUnit CRLF)
					  NIL)
					 ((IGREATERP Verbosity 15)
					  (CPRIN1 15 CRLF "Inside the " SlotToChange " slot, ")
					  (MAPRINT UDiff)
					  (TERPRI)
					  T)
					 (T T]
               ThenDefineNewConcepts [LAMBDA (task)
					     (SETQ NewUnit (CreateUnit CurUnit CurUnit))
					     (PUT NewUnit SlotToChange NewValue)
					     (SETQ NewUnits (CDR (ASSOC (QUOTE NewUnits)
									TaskResults)))
					     [COND (NewUnits (NCONC1 NewUnit NewUnits))
						   (T (SETQ TaskResults (CONS (LIST (QUOTE NewUnits)
										    NewUnit)
									      TaskResults]
					     (ADDPROP (QUOTE H6)
						      (QUOTE Applics)
						      (LIST (LIST (QUOTE TaskNum:)
								  TaskNum task (DATE))
							    (LIST NewUnit)
							    (InitializeCreditAssignment)
							    (LIST (QUOTE Specialized)
								  SlotToChange
								  (QUOTE slot)
								  (QUOTE of)
								  CurUnit
								  (QUOTE as)
								  (QUOTE follows:)
								  UDiff)))
					     [MAPC (SETQ Creditors (CDR (ASSOC (QUOTE CreditTo)
									       CurSup)))
						   (FUNCTION (LAMBDA (H)
								     (ADDPROP H (QUOTE Applics)
									      (LIST (LIST (QUOTE TaskNum:)
											  TaskNum task (DATE))
										    (LIST NewUnit)
										    (DecrementCreditAssignment]
					     (PUT NewUnit (QUOTE Creditors)
						  (SETQ Creditors (CONS (QUOTE H6)
									Creditors)))
					     (ADDPROP CurUnit (QUOTE Specializations)
						      NewUnit)
					     (ADDPROP NewUnit (QUOTE Generalizations)
						      CurUnit)
					     T])
  (PUTPROPS H5 IsA (Heuristic)
               English (IF the current task is to specialize a unit, and no specific slot has been chosen to be the one changed, 
			   THEN randomly select which slots to specialize)
               IfPotentiallyRelevant NULL
               Worth 700
               Applics ((sit1 (win1 los1)))
               Abbrev (Specialize u by specializing some random slots)
               IfAboutToWorkOnTask [LAMBDA (task)
					   (AND (IsAKindOf CurSlot (QUOTE Specializations))
						(NULL (ASSOC (QUOTE SlotToChange)
							     CurSup]
               ThenPrintToUser [LAMBDA (task)
				       (CPRIN1 13 CRLF CurUnit 
					       " will be specialized by specializing the following of its slots: "
					       SlotsToChange CRLF CRLF)
				       T]
               ThenAddToAgenda [LAMBDA (task)
				       (SETQ Agenda (MERGE (SORT [MAPCAR SlotsToChange
									 (FUNCTION (LAMBDA
										     (S)
										     (LIST (Average CurPri (AverageWorths
												      S
												      (QUOTE H5)))
											   CurUnit CurSlot
											   (CONS (SETQ NewReason
												       (CONCAT 
									    "A new unit will be created by specializing the "
													       S " slot of " 
													       CurUnit 
											   "; that slot was chosen randomly."))
												 CurReasons)
											   (LIST (LIST (QUOTE SlotToChange)
												       S)
												 (CONS (QUOTE CreditTo)
												       (CONS (QUOTE H5)
													     CreditTo]
								 T)
							   Agenda T))
				       (SETQ TaskResults (AddPropL TaskResults (QUOTE NewTasks)
								   (LIST (LENGTH SlotsToChange)
									 (QUOTE specific)
									 (QUOTE slots)
									 (QUOTE of)
									 CurUnit
									 (QUOTE to)
									 (QUOTE find)
									 CurSlot
									 (QUOTE of]
               ThenCompute [LAMBDA (task)
				   (SETQ SlotsToChange (SUBSET (SlotNames CurUnit)
							       (QUOTE RandomP)))
				   (SETQ CreditTo (CDR (ASSOC (QUOTE CreditTo)
							      CurSup)))
				   T])
  (PUTPROPS H4 IsA (Heuristic)
               English (IF a new unit has just been synthesized, THEN its a good idea to find instances of it)
               IfPotentiallyRelevant NULL
               Worth 700
               Applics ((sit1 (win1 los1)))
               Abbrev (Plan to gather empirical data about new concepts)
               IfFinishedWorkingOnTask [LAMBDA (task)
					       (SETQ NewUnits (CDR (ASSOC (QUOTE NewUnits)
									  TaskResults]
               ThenPrintToUser [LAMBDA (task)
				       (CPRIN1 13 CRLF (LENGTH NewUnits)
					       " new units ")
				       (CPRIN1 33 ", namely " NewUnits ", ")
				       (CPRIN1 13 
    "were defined.  New tasks are being added to the agenda to ensure that empirical data about them will soon be gathered. "
					       CRLF CRLF)
				       T]
               ThenAddToAgenda [LAMBDA (task)
				       (SETQ Agenda (MERGE [MAPCAR NewUnits (FUNCTION (LAMBDA (NewUnit)
											      (LIST (AverageWorths NewUnit
														   (QUOTE H4))
												    NewUnit
												    (Instances NewUnit)
												    (LIST 
							 "After a unit is synthesized, it is useful to seek instances of it.")
												    (LIST (QUOTE CreditTo)
													  (QUOTE H4]
							   Agenda T))
				       (SETQ TaskResults (AddPropL TaskResults (QUOTE NewTasks)
								   (CONS (LENGTH NewUnits)
									 (QUOTE (new units must have instances found])
  (PUTPROPS Creditors ToDelete1 [LAMBDA (U1 P U2)
					(* U1 is on the P property of unit U2, and is now being deleted. We must remove 
					   accreditaion of U2 from the Applics slot of U1)
					(REM1PROP U1 (QUOTE Applics)
						  (CAR (SOME (GETPROP U1 (QUOTE Applics))
							     (FUNCTION (LAMBDA (a)
									       (EQ (CAADR a)
										   U2]
                      Worth 555
                      IsA (Slot))
  (PUTPROPS Generalizations Worth 500
                            IsA (Slot)
                            SubSlots (SuperSlots)
                            Inverse (Specializations)
                            DataType Unit
                            DoubleCheck T)
  (PUTPROPS Specializations Worth 500
                            IsA (Slot)
                            SubSlots (SubSlots)
                            Inverse (Generalizations)
                            DataType Unit
                            DoubleCheck T)
  (PUTPROPS ThenAddToAgenda Worth 500
                            IsA (Slot)
                            SuperSlots (ThenParts)
                            DataType LispFn)
  (PUTPROPS ThenCompute Worth 500
                        IsA (Slot)
                        SuperSlots (ThenParts)
                        DataType LispFn)
  (PUTPROPS ThenConjecture Worth 500
                           IsA (Slot)
                           SuperSlots (ThenParts)
                           DataType LispFn)
  (PUTPROPS Task Worth 500
                 Format (priority-value unit-name slot-name reasons misc-args))
  (PUTPROPS Abbrev Worth 500
                   IsA (Slot)
                   DataType Text)
  (PUTPROPS ThenDefineNewConcepts Worth 500
                                  IsA (Slot)
                                  SuperSlots (ThenParts)
                                  DataType LispFn)
  (PUTPROPS ThenModifySlots Worth 500
                            IsA (Slot)
                            SuperSlots (ThenParts)
                            DataType LispFn)
  (PUTPROPS ThenPrintToUser Worth 500
                            IsA (Slot)
                            SuperSlots (ThenParts)
                            DataType LispFn)
  (PUTPROPS ThenParts Worth 500
                      IsA (Slot)
                      SubSlots (ThenCompute ThenModifySlots ThenConjecture ThenDefineNewConcepts ThenAddToAgenda ThenPrintToUser)
                      DataType LispFn)
  (PUTPROPS SuperSlots Worth 500
                       Inverse (SubSlots)
                       IsA (Slot)
                       SuperSlots (Generalizations)
                       DataType Slot
                       DoubleCheck T)
  (PUTPROPS IfTaskParts Worth 500
                        IsA (Slot)
                        SubSlots (IfAboutToWorkOnTask IfWorkingOnTask IfFinishedWorkingOnTask)
                        DataType LispPred)
  (PUTPROPS Format Worth 300
                   IsA (Slot)
                   DataType DataType)
  (PUTPROPS los3 Worth 100)
  (PUTPROPS los4 Worth 100)
  (PUTPROPS los7 Worth 100)
  (PUTPROPS los5 Worth 100)
  (PUTPROPS los2 Worth 100)
  (PUTPROPS los1 Worth 100)
  (PUTPROPS los6 Worth 100)
[ADVISE (QUOTE EDITP)
	(QUOTE BEFORE)
	(QUOTE (OR (STKPOS (QUOTE EU))
		   (PRIN1 "
WARNING:  ARE YOU SURE YOU REALLY DON'T MEAN 'EU' ??? !!! "]
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS Agenda CRLF CreditTo Creditors Conjectures CurPri CurReasons CurSlot CurSup CurUnit EditpTemp GCredit Interp 
	  LastEdited NewU NewUnit NewUnits NewValue OldValue RArrow SYSPROPS SlotToChange SlotsToChange Slots TaskNum UDiff Units 
	  UnusedSlots UsedSlots Verbosity WarnSlots conjec cprintmp)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA EU)

(ADDTOVAR NLAML )

(ADDTOVAR LAMA CPRIN1)
)
(DECLARE: DONTCOPY
  (FILEMAP (NIL (3663 27905 (AddInv 3675 . 3971) (AddPropL 3975 . 4230) (Average 4234 . 4346) (AverageWorths 4350 . 4521) (CPRIN1 
4525 . 4762) (Certainty 4766 . 5059) (Check2AfterEditp 5063 . 5356) (CheckAfterEditp 5360 . 5738) (Comp 5742 . 6017) (CreateUnit 
6021 . 6697) (CurSup 6701 . 6796) (CycleThruAgenda 6800 . 7145) (DecrementCreditAssignment 7149 . 7272) (DefineSlot 7276 . 7706) (
DoubleCheck 7710 . 7884) (EU 7888 . 8459) (Eurisko 8463 . 9754) (ExtractPriority 9758 . 9854) (ExtractReasons 9858 . 9956) (
ExtractSlotName 9960 . 10058) (ExtractUnitName 10062 . 10161) (Flatten 10165 . 10337) (FractionOf 10341 . 10608) (Generalizations 
10612 . 10895) (Generalize1LispFn 10899 . 11180) (Generalize1LispPred 11184 . 11467) (GeneralizeLispFn 11471 . 12028) (
GeneralizeLispPred 12032 . 12595) (HasHighWorth 12599 . 12745) (InitializeCreditAssignment 12749 . 12861) (Instances 12865 . 13025
) (Interp1 13029 . 13326) (Interp2 13330 . 14227) (IsAKindOf 14231 . 14354) (KillUnit 14358 . 14927) (MapUnion 14931 . 15215) (NU 
15219 . 16146) (NearnessTo 16150 . 16353) (NewNam 16357 . 16626) (REM1PROP 16630 . 16776) (RandomChoose 16780 . 16892) (RandomP 
16896 . 16989) (RandomSubst 16993 . 17272) (SQUARE 17276 . 17363) (START 17367 . 18003) (SelfIntersect 18007 . 18108) (SetDiff 
18112 . 18319) (SlotNames 18323 . 18477) (Specializations 18481 . 18764) (Specialize1LispFn 18768 . 19334) (Specialize1LispPred 
19338 . 19694) (SpecializeDataType 19698 . 20032) (SpecializeIOPair 20036 . 20218) (SpecializeLispFn 20222 . 20779) (
SpecializeLispPred 20783 . 21346) (SpecializeList 21350 . 21737) (SpecializeNIL 21741 . 21903) (SpecializeNumber 21907 . 22316) (
SpecializeSlot 22320 . 22646) (SpecializeText 22650 . 23037) (SpecializeUnit 23041 . 23367) (TrueIfItExists 23371 . 24092) (
UnionProp 24096 . 24233) (Unitp 24237 . 24410) (WaxOn 24414 . 24750) (WorkOnTask 24754 . 26179) (WorkOnUnit 26183 . 26764) (
XeqIfItExists 26768 . 27774) (YesNo 27778 . 27902)))))
STOP